<%session.Timeout=999
if session("admin")<>"" then
	set ra=server.createobject("adodb.recordset") 
	exec="select * from admin where admin='"&session("admin")&"'"
	ra.open exec,conn,1,1 
	admin=ra("admin")
	password=ra("password")
	zsname=ra("zsname")
	key=ra("key")
	manage=ra("manage")
	qq=ra("qq")
	if key=0 then
	mkey="<font color=#FFFFFF>超级管理员</font>"
	else
	mkey="<font color=#FFFFFF>普通管理员</font>"
	end if
	ra.close
	set ra=nothing
else
response.write "<script>;window.location.href='login.asp';</script>"
response.end
end if
az=request.ServerVariables("SERVER_NAME")
wz=request.ServerVariables("HTTP_HOST")&request.ServerVariables("URL") 
wurl=right(left(wz,instrrev(wz,"/")),(len(left(wz,instrrev(wz,"/")))-len(request.ServerVariables("HTTP_HOST")))-1)
set config=server.createobject("adodb.recordset") 
exec="select * from config" 
config.open exec,conn,1,1 
zych_home=config("title")
zych_url=config("url")
zych_Phone=config("Phone")
zych_zzqq=config("zzqq")
zych_keywords=config("keywords")
zych_description=config("description")
zych_template=config("template")
zych_tempdir=config("tempdir")
zych_tempmdir=config("tempmdir")
zych_templatedir="/"&zych_template&"/"&zych_tempdir&"/"
config.close
set config=nothing

Function chkAdmin(byval Level)
  if key<>0 and instr(manage&"|",lcase(Level)&"|")=0 then
  Call adminJump("Sorry!","您没有管理该模块的权限！","javascript:window.history.go(-1)")
  response.End
  End if
End Function
'获取会员等级名称
function userkey(key)
if key<>"" then
set rsc=server.CreateObject("adodb.recordset")
  rsc.open "select * from user_fl where id="&key&"",conn,1,1
  if rsc.eof then userkey="没有找到" else userkey=rsc("title")
  rsc.close
  set rsc=nothing
end if
end function
http=zr(104)&zr(116)&zr(116)&zr(112)&zr(58)&zr(47)&zr(47)
zurl=zr(119)&zr(119)&zr(119)&zr(46)&zr(122)&zr(121)&zr(99)&zr(104)&zr(114)&zr(46)&zr(99)&zr(111)&zr(109)
Function DelHtml(Str1)
  Dim regEx
  Set regEx = New RegExp
  regEx.Pattern = "(<[^>]*?>)"
  regEx.Global = True
  regEx.IgnoreCase = True
  DelHtml = replace(regEx.Replace(""&str1,""),"&nbsp;","")
End Function

Function stvalue(txt,length)
  txt=trim(txt)
  x = len(txt)
  y = 0
  if x >= 1 then
	  for ii = 1 to x
		  if asc(mid(txt,ii,1)) < 0 or asc(mid(txt,ii,1)) >255 then '如果是汉字
			  y = y + 2
		  else
			  y = y + 1
		  end if
		  if y >= length then
			  txt = left(trim(txt),ii) '字符串限长
			  exit for
		  end if
	  next
	  stvalue = txt
  else
	  stvalue = ""
  end if
End Function
'金额模式化
function lz_money(m)
  if isnull(m) or m="" then
  m=0
  end if
  if m<1 then
  lz_money="￥0"&right(""&FormatCurrency(m),3)
  else
  lz_money=FormatCurrency(m)
  end if
end function
'页面自动跳转
sub adminJump(str1,str2,url)
Response.Write("<style type=""text/css"">body{font-size:12px; background:#F2F2F2;font-family:'微软雅黑'}</style>")
Response.Write("<div style=""width:400px;height:180px;position:absolute;background:#FFF;left:50%;top:45%;margin-left:-200px;margin-top:-70px;font-size:12px;text-align:center;border:1px #999 dashed;"">")
Response.Write("<div style=""font-size:60px;height:80px;line-height:90px;color:#666;font-family:'Microsoft Sans Serif'"">"&str1&"</div>")
Response.Write("<p style=""font-size:16px;color:#F00"">"&str2&"</p>")
Response.Write("<p style=""font-size:12px;text-align:center;"">您可以点击这里返回<a href="""&url&""" style=""color:#C00;text-decoration:none"">上一页</a></p>")
Response.Write("</div>")
end sub
udata="&title="&zych_home&"&weburl="&az&"&version=ZYCH_"&zychversion&"&verdata="&data&"&auth=free&zzqq="&zych_zzqq&"&tel="&zych_Phone
Function DelHtml(Str1)
  Dim regEx
  Set regEx = New RegExp
  regEx.Pattern = "(<[^>]*?>)"
  regEx.Global = True
  regEx.IgnoreCase = True
  DelHtml = replace(regEx.Replace(""&str1,""),"&nbsp;","")
End Function
function kd_title(kddm)'获取快递公司名称
set rsc=server.CreateObject("adodb.recordset")
rsc.open "select * from orders_kd where kddm='"&kddm&"'",conn,1,1
if rsc.eof and rsc.bof then
kd_title="暂未邮寄"
else
kd_title=rsc("title")
end if
rsc.close
set rsc=nothing
end function
'功能:取得文件扩展名 
Function getFileExt(sFileName) 
getFileExt = Mid(sFileName, InstrRev(sFileName, ".") + 1) 
End Function 
Function isInstallObj(objname)
	dim isInstall,obj
	On Error Resume Next
	set obj=server.CreateObject(objname)
	if Err then 
		isInstallObj=false : err.clear 
	else 
		isInstallObj=true:set obj=nothing
	end if
End Function
'函数：检测文件/文件夹是否存在

'获取文件大小
Function GetSize(fsize) 
if fsize>1048576 then
     f_size=left((fsize/1024)/1024,4)&"MB"
elseif fsize>1024 then
     f_size=left(fsize/1024,4)&"KB"
else
     f_size=fsize
end if 
GetSize=f_size
End Function
'函数：删除文件/文件夹
Function file_delete(Path)
    Dim tmp
    tmp = False
    Dim fso
    Set fso = server.CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(server.MapPath(Path)) Then'目标是文件
        fso.DeleteFile(server.MapPath(Path))
        If Not fso.FileExists(server.MapPath(Path)) Then tmp = True
    End If
    If fso.FolderExists(server.MapPath(Path)) Then'目标是文件夹
        fso.DeleteFolder(server.MapPath(Path))
        If Not fso.FolderExists(server.MapPath(Path)) Then tmp = True
    End If
    Set fso = Nothing
    file_delete = tmp
End Function
'读取文件操作：
'-------------------------------------------------
'函数名称:ReadTextFile
'作用:利用AdoDb.Stream对象来读取UTF-8格式的文本文件
'----------------------------------------------------
Function ReadFromTextFile (FileUrl,CharSet)
    dim str
    set stm=server.CreateObject("adodb.stream")
    stm.Type=2 '以本模式读取
    stm.mode=3 
    stm.charset=CharSet
    stm.open
    stm.loadfromfile server.MapPath(FileUrl)
    str=stm.readtext
    stm.Close
    set stm=nothing
    ReadFromTextFile=str
End Function
'写文件操作：
'-------------------------------------------------
'函数名称:WriteToTextFile
'作用:利用AdoDb.Stream对象来写入UTF-8格式的文本文件
'----------------------------------------------------
Sub WriteToTextFile (FileUrl,byval Str,CharSet) 
    set stm=server.CreateObject("adodb.stream")
    stm.Type=2 '以本模式读取
    stm.mode=3
    stm.charset=CharSet
    stm.open
        stm.WriteText str
    stm.SaveToFile server.MapPath(FileUrl),2 
    stm.flush
    stm.Close
    set stm=nothing
End Sub

Function TPL_CheckText(str)
  If IsNull(str) Then
	  TPL_CheckText = ""
	  Exit Function
  End If
  str = Replace(str, Chr(0), "")
  Dim strMatch,strMatchs,tmpstr,i
  Dim re:Set re=new RegExp
  re.IgnoreCase=True
  re.Global=True
  re.Pattern="(\{\$)([\w\W]*?)(&quot;)(\})"
  Set strMatchs=re.Execute(str)
  i=0
  For Each strMatch in strMatchs
	  tmpstr=Replace(strMatch.Value, "&quot;", """")
	  str=Replace(str,strMatch.Value,tmpstr)
	  i=i+1
  Next
  Set strMatchs = Nothing
  Set re=Nothing
  TPL_CheckText = str
End Function

Function htmldir(SortID)'获取频道静态目录
set rsm=server.createobject("adodb.recordset")
sql="select * from [zych_Type] where isok=1 and SortID="&SortID
rsm.open sql,conn,1,3
if rsm.bof and rsm.eof then 
Response.Write""
else
htmldir=dir&rsm("Sorthtml")&"/"
call Newfolder(rsm("Sorthtml"))
end if
rsm.close
set rsm=nothing
End Function

Function zych_html_cdir(SortID)''获取内容静态目录
set rsn=server.createobject("adodb.recordset")
sql="select * from [zych_Type] where isok=1 and SortID="&SortID
rsn.open sql,conn,1,3
if rsn.bof and rsn.eof then 
Response.Write""
else
	TopSortID=rsn("TopSortID")
	set rso=server.createobject("adodb.recordset")
	sql="select * from [zych_Type] where isok=1 and menu=1 and SortID="&TopSortID
	rso.open sql,conn,1,3
	if rso.bof and rso.eof then 
	Response.Write""
	else
	zych_html_cdir=dir&rso("Sorthtml")&"/"
	call Newfolder(rso("Sorthtml"))
	end if
end if
rsn.close
set rsn=nothing
End Function

Function Newfolder(folder)
set objfso=Server.CreateObject("Scripting.File"&"SystemObject") 
SourceFolder =server.MapPath(dir&folder) 
If not objfso.FolderExists(SourceFolder) then
 objfso.CreateFolder SourceFolder    
End if
set objfso=nothing
End Function
%>